home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / STRSORT.BAS < prev    next >
BASIC Source File  |  1989-08-31  |  2KB  |  86 lines
  1. ' STRSORT.BAS
  2. ' This program prompts the user for a list of names and then sorts them
  3. '   alphabetically.
  4.  
  5. ' set maximum number of lines that can be entered and declare string
  6. '   array to hold lines
  7.  
  8. CONST MAXLINES% = 15
  9. DIM inputLines$(MAXLINES%)
  10.  
  11. ' declare GetText and ShellSort subprograms
  12.  
  13. DECLARE SUB GetText (strArray$(), numOfElements%)
  14. DECLARE SUB ShellSort (strArray$(), numOfElements%)
  15.  
  16. CLS
  17.  
  18. ' call GetText subprogram to get input from user; at return the
  19. '   numOfElements% variable will contain number of lines received
  20.  
  21. GetText inputLines$(), numOfElements%
  22.  
  23. ' call ShellSort subprogram to put inputLines$() array in
  24. '   alphabetical order
  25.  
  26. ShellSort inputLines$(), numOfElements%
  27.  
  28. PRINT
  29. PRINT "Sorting results:"
  30. PRINT
  31.  
  32. FOR i% = 1 TO numOfElements%    ' print contents of sorted array
  33.     PRINT inputLines$(i%)
  34. NEXT i%
  35.  
  36. END
  37.  
  38. SUB GetText (strArray$(), count%)
  39.  
  40. ' The GetText subprogram fills the strArray$() array with text
  41. '   entered at the keyboard.  The number of lines that can be
  42. '   entered is determined by the global constant MAXLINES%.
  43. '   Both strArray$() and count% (the number of lines actually
  44. '   entered) are returned to the main program.
  45.  
  46. PRINT "Enter up to"; MAXLINES%; "lines of text; to end, ";
  47. PRINT "press Enter on a new line."
  48. PRINT
  49. count% = 0
  50.    
  51. DO
  52.     LINE INPUT "-> "; inLine$  ' get line from user
  53.     IF (inLine$ <> "") THEN    ' if line is not blank, copy it
  54.         count% = count% + 1    '   to the strArray$() array
  55.         strArray$(count%) = inLine$
  56.     END IF
  57. ' loop until count% = MAXLINES% or an empty line is received
  58. LOOP WHILE (count% < MAXLINES%) AND (inLine$ <> "")
  59.  
  60. END SUB
  61.  
  62. SUB ShellSort (strArray$(), numOfElements%)
  63.  
  64. ' The ShellSort subprogram sorts the elements of strArray$() and
  65. '   returns strArray$() to the main program.  The numOfElements%
  66. '   argument contains the number of elements in strArray$().
  67. '   ShellSort sorts elements in decending order.
  68.  
  69. span% = numOfElements% \ 2
  70.    
  71. DO WHILE span% > 0
  72.     FOR i% = span% TO numOfElements% - 1
  73.         j% = i% - span% + 1
  74.         FOR j% = (i% - span% + 1) TO 1 STEP -span%
  75.             IF strArray$(j%) <= strArray$(j% + span%) THEN EXIT FOR
  76.             ' swap array elements that are out of order
  77.             SWAP strArray$(j%), strArray$(j% + span%)
  78.         NEXT j%
  79.     NEXT i%
  80.  
  81.     span% = span% \ 2
  82. LOOP
  83.  
  84. END SUB
  85.  
  86.